home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 19 / 8 / DISK1982.ZIP / DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-15  |  17KB  |  435 lines
  1. {--------------------------------------------------------------------}
  2. {- Before compiling this demo program make sure the Unit Directories-}
  3. {- in the Options, Directories menu specify where to find the       -}
  4. {- FlashPac Units.                                                  -}
  5. {-                                                                  -}
  6. {- Compiler       Directory                                         -}
  7. {- --------       -----------------                                 -}
  8. {-  TP4           A:\TP4                                            -}
  9. {-  TP5           A:\TP5                                            -}
  10. {-  TP55          A:\TP55                                           -}
  11. {-  TP60          A:\TP60                                           -}
  12. {--------------------------------------------------------------------}
  13.  
  14.  
  15. Program Demo;
  16. Uses Crt,FPVideo,FPKbd,FPGetKey,FPMouse;
  17.  
  18. Const                                       { color is 1 and monochrome is 2 }
  19.    ColorTbl : Array[1..2,0..255] Of Byte =
  20.                         (  ( 000,001,002,003,004,005,006,007,008,009,
  21.                              010,011,012,013,014,015,016,017,018,019,
  22.                              020,021,022,023,024,025,026,027,028,029,
  23.                              030,031,032,033,034,035,036,037,038,039,
  24.                              040,041,042,043,044,045,046,047,048,049,
  25.                              050,051,052,053,054,055,056,057,058,059,
  26.                              060,061,062,063,064,065,066,067,068,069,
  27.                              070,071,072,073,074,075,076,077,078,079,
  28.                              080,081,082,083,084,085,086,087,088,089,
  29.                              090,091,092,093,094,095,096,097,098,099,
  30.                              100,101,102,103,104,105,106,107,108,109,
  31.                              110,111,112,113,114,115,116,117,118,119,
  32.                              120,121,122,123,124,125,126,127,128,129,
  33.                              130,131,132,133,134,135,136,137,138,139,
  34.                              140,141,142,143,144,145,146,147,148,149,
  35.                              150,151,152,153,154,155,156,157,158,159,
  36.                              160,161,162,163,164,165,166,167,168,169,
  37.                              170,171,172,173,174,175,176,177,178,179,
  38.                              180,181,182,183,184,185,186,187,188,189,
  39.                              190,191,192,193,194,195,196,197,198,199,
  40.                              200,201,202,203,204,205,206,207,208,209,
  41.                              210,211,212,213,214,215,216,217,218,219,
  42.                              220,221,222,223,224,225,226,227,228,229,
  43.                              230,231,232,233,234,235,236,237,238,239,
  44.                              240,241,242,243,244,245,246,247,248,249,
  45.                              250,251,252,253,254,255 ),
  46.  
  47.                            ( 000,001,002,003,004,005,006,007,008,009,
  48.                              010,011,012,013,014,015,016,017,018,019,
  49.                              020,021,022,023,024,025,026,027,028,029,
  50.                              030,031,032,033,034,035,036,037,038,039,
  51.                              040,041,042,043,044,045,046,047,048,049,
  52.                              050,051,052,053,054,055,056,057,058,059,
  53.                              060,061,062,063,064,065,066,067,068,069,
  54.                              070,071,072,073,074,075,076,077,078,079,
  55.                              080,081,082,083,084,085,086,087,088,089,
  56.                              090,091,092,093,094,095,096,097,098,099,
  57.                              100,101,102,103,104,105,106,107,108,109,
  58.                              110,111,112,113,114,115,116,117,118,119,
  59.                              120,121,122,123,124,125,126,127,128,129,
  60.                              130,131,132,133,134,135,136,137,138,139,
  61.                              140,141,142,143,144,145,146,147,148,149,
  62.                              150,151,152,153,154,155,156,157,158,159,
  63.                              160,161,162,163,164,165,166,167,168,169,
  64.                              170,171,172,173,174,175,176,177,178,179,
  65.                              180,181,182,183,184,185,186,187,188,189,
  66.                              190,191,192,193,194,195,196,197,198,199,
  67.                              200,201,202,203,204,205,206,207,208,209,
  68.                              210,211,212,213,214,215,216,217,218,219,
  69.                              220,221,222,223,224,225,226,227,228,229,
  70.                              230,231,232,233,234,235,236,237,238,239,
  71.                              240,241,242,243,244,245,246,247,248,249,
  72.                              250,251,252,253,254,255 )
  73.                         );
  74. Type
  75.    TBuffer = Array[1..320] Of Char;
  76.    Str4    = String[4];
  77. Var
  78.    Buffer   : Array[1..4000] Of Char;
  79.    i,x,y    : Integer;
  80.    CTbl     : Array[0..255] Of Byte;
  81.    FnKeyBuf : Array[1..4] Of TBuffer;
  82.  
  83. {------------------------------------------------------------------}
  84. {-                                                                -}
  85. {------------------------------------------------------------------}
  86.  
  87. Procedure OpeningScreen;
  88. Var
  89.    i : Integer;
  90. Begin
  91.    ClrWin(1,1,80,25,CTbl[7]);
  92.    Window(1,1,80,25);
  93.    FrameWin('╔','╗','╚','╝','═','║',CTbl[2]);
  94.  
  95.    ColorMsg(20, 4,CTbl[1],'         FlashPac Pascal Library         ');
  96.    ColorMsg(20, 6,CTbl[2],'               Version 3.10              ');
  97.    ColorMsg(20, 8,CTbl[3],'               Demo Program              ');
  98.    ColorMsg(20,15,CTbl[4],'              SimpleSoft Inc.            ');
  99.    ColorMsg(20,16,CTbl[4],'              1209 Poplar St             ');
  100.    ColorMsg(20,17,CTbl[4],'          La Crescent, MN  55947         ');
  101.    ColorMsg(20,18,CTbl[4],'                                         ');
  102.    ColorMsg(14,22,CTbl[4],'(c) Copyright SimpleSoft 1986-89 - All Rights Reserved');
  103.    ColorMsg(20,24,CTbl[5],'       Press any key to continue...      ');
  104.  
  105.    While Not DosKbdHit Do Begin
  106.       FillRowAttr(20, 4,41,CTbl[9]);
  107.       FillRowAttr(20, 6,41,CTbl[10]);
  108.       FillRowAttr(20, 8,41,CTbl[11]);
  109.       FillRowAttr(20,15,41,CTbl[12]);
  110.       FillRowAttr(20,16,41,CTbl[12]);
  111.       FillRowAttr(20,17,41,CTbl[12]);
  112.       FillRowAttr(20,18,41,CTbl[12]);
  113.       FillRowAttr(14,22,54,CTbl[13]);
  114.       Delay(300);
  115.       FillRowAttr(20, 4,41,CTbl[1]);
  116.       FillRowAttr(20, 6,41,CTbl[2]);
  117.       FillRowAttr(20, 8,41,CTbl[3]);
  118.       FillRowAttr(20,15,41,CTbl[4]);
  119.       FillRowAttr(20,16,41,CTbl[4]);
  120.       FillRowAttr(20,17,41,CTbl[4]);
  121.       FillRowAttr(20,18,41,CTbl[4]);
  122.       FillRowAttr(14,22,54,CTbl[5]);
  123.       Delay(300);
  124.    End;
  125. End;
  126.  
  127. {------------------------------------------------------------------}
  128. {-                                                                -}
  129. {------------------------------------------------------------------}
  130.  
  131. Procedure DisplayWindows;
  132. Const
  133.    NumberWindows = 6;
  134.  
  135.    WinTbl : Array[1..NumberWindows,1..5] Of Byte = (
  136.                                                      (  1,  1, 40, 10,  16 ),
  137.                                                      (  4,  4, 43, 13,  36 ),
  138.                                                      (  7,  7, 46, 16,  56 ),
  139.                                                      ( 10, 10, 49, 19,  76 ),
  140.                                                      ( 13, 13, 52, 21,  96 ),
  141.                                                      ( 16, 16, 55, 23, 116 )
  142.                                                    );
  143. Var
  144.    i,j,k : Integer;
  145.    St    : String;
  146. Begin
  147.    ClrWin(1,1,80,25,CTbl[7]);
  148.    For i := 1 To NumberWindows Do Begin
  149.       Window(WinTbl[i,1],WinTbl[i,2],WinTbl[i,3],WinTbl[i,4]);
  150.       ClrWin(WinTbl[i,1],WinTbl[i,2],WinTbl[i,3],WinTbl[i,4],WinTbl[i,5]);
  151.       FrameWin('╔','╗','╚','╝','═','║',CTbl[WinTbl[i,5]]);
  152.       Str(i:1,St);
  153.       DspMsg(WinTbl[i,1]+2,WinTbl[i,2]+1,'Window - ' + St);
  154.       Delay(500);
  155.    End;
  156.    ColorMsg(20,25,CTbl[96],'       Press any key to continue...      ');
  157.    DosKbdClr;
  158.    i := GetKey;
  159. End;
  160.  
  161. {------------------------------------------------------------------}
  162. {-                                                                -}
  163. {------------------------------------------------------------------}
  164.  
  165. Procedure GetAltCtrlShft;
  166. Var
  167.    i        : Integer;
  168. Begin
  169.    ClrWin(1,1,80,25,CTbl[7]);
  170.  
  171.    ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the normal lines');
  172.    ColorMsg(10,16,CTbl[5],'        Press any key to continue...         ');
  173.    ColorMsg(1,1,CTbl[6],'F1-Normal        F2-Normal        F3-Normal        F4-Normal        F5 -Normal');
  174.    ColorMsg(1,2,CTbl[6],'F6-Normal        F7-Normal        F8-Normal        F9-Normal        F10-Normal');
  175.    GetScrn(1,1,160,FnKeyBuf[1]);
  176.    DosKbdClr;
  177.    i := GetKey;
  178.  
  179.    ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Shft lines  ');
  180.    ColorMsg(10,16,CTbl[5],'        Press any key to continue...         ');
  181.    ColorMsg(1,1,CTbl[6],'F1-Shft          F2-Shft          F3-Shft          F4-Shft          F5 -Shft  ');
  182.    ColorMsg(1,2,CTbl[6],'F6-Shft          F7-Shft          F8-Shft          F9-Shft          F10-Shft  ');
  183.    GetScrn(1,1,160,FnKeyBuf[2]);
  184.    DosKbdClr;
  185.    i := GetKey;
  186.  
  187.    ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Ctrl lines  ');
  188.    ColorMsg(10,16,CTbl[5],'        Press any key to continue...         ');
  189.    ColorMsg(1,1,CTbl[6],'F1-Ctrl          F2-Ctrl          F3-Ctrl          F4-Ctrl          F5 -Ctrl  ');
  190.    ColorMsg(1,2,CTbl[6],'F6-Ctrl          F7-Ctrl          F8-Ctrl          F9-Ctrl          F10-Ctrl  ');
  191.    GetScrn(1,1,160,FnKeyBuf[3]);
  192.    DosKbdClr;
  193.    i := GetKey;
  194.  
  195.    ColorMsg(10,15,CTbl[4],'I will use GetScrn to read the Alt lines   ');
  196.    ColorMsg(10,16,CTbl[5],'        Press any key to continue...         ');
  197.    ColorMsg(1,1,CTbl[6],'F1-Atl           F2-Alt           F3-Alt           F4-Alt           F5 -Alt   ');
  198.    ColorMsg(1,2,CTbl[6],'F6-Alt           F7-Alt           F8-Alt           F9-Alt           F10-Alt   ');
  199.    GetScrn(1,1,160,FnKeyBuf[4]);
  200.    DosKbdClr;
  201.    i := GetKey;
  202. End;
  203.  
  204. {------------------------------------------------------------------}
  205. {-                                                                -}
  206. {------------------------------------------------------------------}
  207.  
  208. Procedure DetectToggleKeys;
  209. Var
  210.    i,Index : Integer;
  211. Begin
  212.    ClrWin(1,1,80,25,CTbl[7]);
  213.    Window(8,1,55,12);
  214.    FrameWin('╔','╗','╚','╝','═','║',CTbl[15]);
  215.    ColorMsg(10, 3,CTbl[23],'             BiosKbdStat                    ');
  216.    ColorMsg(10, 5,CTbl[10],' Pressing the Alt, Shft or Ctrl Toggle Keys ');
  217.    FillRowAttr(24,5,3,CTbl[64]);
  218.    FillRowAttr(29,5,4,CTbl[65]);
  219.    FillRowAttr(37,5,4,CTbl[66]);
  220.  
  221.    ColorMsg(10, 6,CTbl[10],' will display the function key lines at the ');
  222.    ColorMsg(10, 7,CTbl[10],' bottom of the screen.  The lines that are  ');
  223.    ColorMsg(10, 8,CTbl[10],' being used were just saved using GetScrn   ');
  224.    ColorMsg(10, 9,CTbl[10],' in the preceeding step.                    ');
  225.    ColorMsg(10,11,CTbl[48],'        Press <ENTER> to continue...        ');
  226.  
  227.    i := 0;
  228.    While ( i <> 13 ) Do Begin
  229.       While Not DosKbdHit Do Begin
  230.          i := BiosKbdStat;
  231.  
  232.          Index := 1;
  233.          If (i And 3) <> 0 Then       Index := 2
  234.          Else If (i And 4) <> 0 Then  Index := 3
  235.          Else If (i And 8) <> 0 Then  Index := 4;
  236.  
  237.          PutScrn(1,24,160,FnKeyBuf[Index]);
  238.       End;
  239.       i := GetKey;
  240.    End;
  241. End;
  242.  
  243. {------------------------------------------------------------------}
  244. {-                                                                -}
  245. {------------------------------------------------------------------}
  246.  
  247. Procedure DisplayVideoInformation;
  248. Var
  249.    i  : Integer;
  250.    Ch : Char;
  251.    St : String;
  252.  
  253.    {---------------------------------------------------------------}
  254.    {-                                                             -}
  255.    {---------------------------------------------------------------}
  256.  
  257.    Function Dec_To_Hex(Number : Word) : Str4;
  258.    Const
  259.       Digits : String[16] = '0123456789ABCDEF';
  260.    Var
  261.       i  : Word;
  262.       St : String[4];
  263.    Begin
  264.       FillChar(St,SizeOf(St),0);
  265.       For i := 4 DownTo 1 Do Begin
  266.          St[i] := Digits[Number Mod 16 + 1];
  267.          Number := Number Div 16;
  268.       End;
  269.       St[0] := Chr(4);
  270.       Dec_To_Hex := St;
  271.    End;
  272.  
  273. {------------------------------------------------------------------}
  274.  
  275. Begin
  276.    ClrWin(1,1,80,25,CTBl[7]);
  277.    Window(24,9,57,17);
  278.    ClrWin(24,9,57,17,CTbl[48]);
  279.    FrameWin('╔','╗','╚','╝','═','║',48);
  280.    ColorMsg(26,9,CTbl[48],' GetVideoInfo ');
  281.  
  282.    Str(GetVideoMode:1,St);
  283.    ColorMsg(25,10,CTbl[48],' Current mode         = ' + St);
  284.  
  285.    Str(GetVideoPage:1,St);
  286.    ColorMsg(25,11,CTbl[48],' Active page          = ' + St);
  287.  
  288.    Str(GetVideoCols:1,St);
  289.    ColorMsg(25,12,CTbl[48],' Number cols          = ' + St);
  290.  
  291.    St := Dec_To_Hex(VioBaseSeg);
  292.    ColorMsg(25,13,CTbl[48],' Base Segment Address = ' + St);
  293.  
  294.    ColorMsg(25,16,CTbl[48],' Press any key to continue...');
  295.    i := GetKey;
  296. End;
  297.  
  298. {------------------------------------------------------------------}
  299. {-                                                                -}
  300. {------------------------------------------------------------------}
  301.  
  302. Procedure UseEditSt;
  303. Const
  304.    TCSet : TSet = [13];
  305.    VCSet : TSet = [32,65..122];
  306. Var
  307.    Ch          : Char;
  308.    Char_Ofs,TE : Integer;
  309.    St          : String;
  310. Begin
  311.    ClrWin(1,1,80,25,CTbl[7]);
  312.    Window(8,8,50,14);
  313.    FrameWin('╔','╗','╚','╝','═','║',CTbl[48]);
  314.  
  315.    ColorMsg(10,10,CTbl[7],'Enter your name:');
  316.    ColorMsg(9,12,CTbl[48],'          Press <ENTER> to Quit          ');
  317.    St       := '';
  318.    Char_Ofs := 1;
  319.    TE       := 0;
  320.    FillChar(St,SizeOf(St),0);
  321.    EditSt(10,28,48,50,1,7,0,7000,2000,VCSet,TCSet,Char_Ofs,TE,St);
  322.  
  323.    ClrWin(1,1,80,25,CTbl[7]);
  324.    Window(5,8,75,14);
  325.    FrameWin('╔','╗','╚','╝','═','║',CTbl[48]);
  326.  
  327.    GotoxyAbs(7,10);
  328.    Writeln('Length of Input string returned = ',Length(St):1,' characters');
  329.    GotoxyAbs(7,12);
  330.    WriteSt('Input string = *' + St + '*');
  331.    ColorMsg(20,20,CTbl[6],'    Press any key to continue...    ');
  332.    TE := GetKey;
  333. End;
  334.  
  335. {------------------------------------------------------------------}
  336. {-                                                                -}
  337. {------------------------------------------------------------------}
  338.  
  339. Procedure DisplayRvsAttrScreen;
  340. Var
  341.    St    : String;
  342.    Ch    : Char;
  343.    i,j,k : Integer;
  344.    HiCur,LoCur : Integer;
  345. begin
  346.    HiCur := Hi(VioCursor);
  347.    LoCur := Lo(VioCursor);
  348.    SetCursorSize(32,32);
  349.    ClrWin(1,1,80,25,CTbl[7]);
  350.  
  351.    Window(5,2,40,19);
  352.    FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
  353.    ColorMsg(7,2,CTbl[7],' Text with normal attributes ');
  354.  
  355.    Window(45,2,80,19);
  356.    FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
  357.    ColorMsg(47,2,CTbl[7],' Text with reverse attributes ');
  358.    ColorMsg(30,23,CTbl[6],'    Press <ESC> to skip...    ');
  359.    k := 0;
  360.    j := 1;
  361.    While ( j <= 16 ) Do Begin
  362.       ClrWin(6,3,39,18,CTbl[7]);
  363.       ClrWin(46,3,79,18,CTbl[7]);
  364.       For i := 0 To 15 Do Begin
  365.  
  366.          TextAttr := k;
  367.          Str(TextAttr:3,St);
  368.          ColorMsg( 6,i+3,TextAttr,'        TextAttr = '+St+'            ');
  369.  
  370.          TextAttr := RvsAttr(TextAttr);
  371.          Str(TextAttr:3,St);
  372.          ColorMsg(46,i+3,TextAttr,'       TextAttr = '+St+'             ');
  373.          k := k + 1;
  374.       End;
  375.       Delay(1500);
  376.  
  377.       If ( BiosKbdHit ) Then
  378.          If ( GetKey = 1 ) Then
  379.             j := 16;
  380.  
  381.       j := j + 1;
  382.    End;
  383.    TextAttr := 6;
  384.    SetCursorSize(LoCur,HiCur);
  385. End;
  386.  
  387. {------------------------------------------------------------------}
  388. {-                                                                -}
  389. {------------------------------------------------------------------}
  390.  
  391. Procedure CheckMouse;
  392. Var
  393.    i,NBut : Integer;
  394. Begin
  395.    i := 0;
  396.    ClrWin(1,1,80,25,CTbl[7]);
  397.    Window(8,10,48,15);
  398.    FrameWin('╔','╗','╚','╝','═','║',CTbl[7]);
  399.  
  400.    i := MResetMouse( NBut );
  401.    If i = 0 Then
  402.       ColorMsg( 10, 12, CTbl[6], 'Mouse NOT installed on your computer' )
  403.    Else Begin
  404.       ColorMsg( 10, 12, CTbl[6], 'You have a mouse in your computer' );
  405.       ColorMsg( 10, 13, CTbl[7], 'Squeak Squeak Squeak' );
  406.    End;
  407.    ColorMsg( 10, 20, CTbl[6], '    Press any key to continue...    ' );
  408.    NBut := GetKey;
  409. End;
  410.  
  411. {--------------------- Main Line -------------------------}
  412.  
  413. Begin
  414.    If VioMode = 7 Then i := 2
  415.    Else                i := 1;
  416.    Move( ColorTbl[i,0], CTbl[0], SizeOf(CTbl) );
  417.  
  418.    GetScrn(1,1,2000,Buffer);
  419.    x := WhereXAbs;
  420.    y := WhereYAbs;
  421.    i := 1;
  422.  
  423.    OpeningScreen;
  424.    DisplayWindows;
  425.    GetAltCtrlShft;
  426.    DetectToggleKeys;
  427.    DisplayVideoInformation;
  428.    UseEditSt;
  429.    DisplayRvsAttrScreen;
  430.    CheckMouse;
  431.  
  432.    PutScrn(1,1,2000,Buffer);
  433.    GotoxyAbs(x,y);
  434. End.
  435.